Internet Info 1993/Internet Info CD-ROM (Walnut Creek) (1993).iso/networking/terms/kermit/d/rdosker.fr

Text File | 1988-08-16 | 67.2 KB | 2,249 lines

CCCCCCCCCCCCC  BUFEMP.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE BUFEMP(BUFFER,LEN)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER BUFFER(1)
      INTEGER CH,LEN,CTL
      INTEGER I,T
      CH=FD
      I=1
23000 IF(.NOT.(I.LT.LEN+1))GOTO 23002
      T=BUFFER(I)
      IF(.NOT.(T.EQ.35 ))GOTO 23003
      I=I+1
      T=BUFFER(I)
      IF(.NOT.(T.NE.35 ))GOTO 23005
      T=CTL(T)
23005 CONTINUE
23003 CONTINUE
      IF(.NOT.(T.NE.10))GOTO 23007
      CALL KPUTCH(T,CH)
23007 CONTINUE
23001 I=I+1
      GOTO 23000
23002 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  BUFILL.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION BUFILL(BUFFER)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER I,CTL,T,KGETCH,BUFFER(1),CH
      I=1
      CH=FD
23000 IF(.NOT.(KGETCH(T,CH).GT.0))GOTO 23001
      IF(.NOT.((T.LT.32 ).OR.(T.EQ.127 ).OR.(T.EQ.QUOTE)))GOTO 23002
      IF(.NOT.(T.EQ.13))GOTO 23004
      BUFFER(I)=QUOTE
      I=I+1
      BUFFER(I)=CTL(13)
      T=10
      I=I+1
23004 CONTINUE
      BUFFER(I)=QUOTE
      I=I+1
      IF(.NOT.(T.NE.QUOTE))GOTO 23006
      T=CTL(T)
23006 CONTINUE
23002 CONTINUE
      BUFFER(I)=T
      I=I+1
      IF(.NOT.(I.GT.SPSIZ-8))GOTO 23008
      BUFILL=I-1
      RETURN
23008 CONTINUE
      GOTO 23000
23001 CONTINUE
      IF(.NOT.(I.EQ.1))GOTO 23010
      BUFILL=10003
      RETURN
23010 CONTINUE
      BUFILL=I-1
      RETURN
      END
CCCCCCCCCCCCC   CANT.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       SUBROUTINE CANT(BUF)
      INTEGER BUF(132)
      CALL PUTLIN(BUF, 2)
      CALL REMARK(": can't open.")
      CALL RATEXIT
      END
CCCCCCCCCCCCC   CHKIO.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE CHKIO (FD, IER)
      INTEGER FD, IER
      IF(.NOT.(IER .EQ. 1 .OR. IER .EQ. 9))GOTO 23000
      RETURN
23000 CONTINUE
      WRITE (2, 1) IER, FD
      CALL MESSAGE('CHKIO -- ERROR TRACEBACK')
1     FORMAT(" *** error code ", I6, " from channel ", I6)
      RETURN
      END
CCCCCCCCCCCCC CLOSE.FT      CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE RATCLOSE (FD)
      INTEGER FD
      COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
     *:15), IC(0:15), MD(0:15)
      INTEGER CHANNEL
      INTEGER APOS
      INTEGER VPOS
      INTEGER LINEBUF
      INTEGER NC
      INTEGER IC
      INTEGER MD
      IF(.NOT.(0 .LE. FD .AND. FD .LE. 15))GOTO 23000
      CALL FLUSH (FD)
      CALL CLOSE (FD, IER)
      CHANNEL(FD) = 10001
      MD(FD) = 2
23000 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  COMPILE.MC       CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
MESSAGE Compiling subroutines for installing KERMIT-RDOS
MESSAGE

FORTRAN/P/M BUFEMP
FORTRAN/P/M BUFILL
FORTRAN/P/M CONNECT
FORTRAN/P/M CTL
FORTRAN/P/M FINDLN
FORTRAN/P/M IBMGETLIN
FORTRAN/P/M KERMIT
FORTRAN/P/M KGETCH
FORTRAN/P/M KGETLIN
FORTRAN/P/M KPICK
FORTRAN/P/M KPUTCH
FORTRAN/P/M RDATA
FORTRAN/P/M RECSW
FORTRAN/P/M RFILE
FORTRAN/P/M RINIT
FORTRAN/P/M RPACK
FORTRAN/P/M RPAR
FORTRAN/P/M SDATA
FORTRAN/P/M SENDSW
FORTRAN/P/M SEOF
FORTRAN/P/M SBREAK
FORTRAN/P/M SFILE
FORTRAN/P/M SINIT
FORTRAN/P/M SPACK
FORTRAN/P/M SPAR
FORTRAN/P/M TOCHAR
FORTRAN/P/M UNCHAR
FORTRAN/P/M UPPER
FORTRAN/P/M VERIFY
MESSAGE Compiling all the library subroutines for KERMIT-RDOS
MESSAGE
FORTRAN/P/M CANT
FORTRAN/P/M CHKIO
FORTRAN/P/M CLOSE
FORTRAN/P/M EXIT
FORTRAN/P/M FLUSH
FORTRAN/P/M GETCH
FORTRAN/P/M GETLIN
FORTRAN/P/M ITOC
FORTRAN/P/M LENGTH
FORTRAN/P/M OPEN
FORTRAN/P/M PACK
FORTRAN/P/M PUTC
FORTRAN/P/M PUTCH
FORTRAN/P/M PUTDEC
FORTRAN/P/M PUTINT
FORTRAN/P/M PUTLIN
FORTRAN/P/M PUTSTR
FORTRAN/P/M REMARK
FORTRAN/P/M REMOVE
FORTRAN/P/M SCOPY
FORTRAN/P/M SSCOPY
FORTRAN/P/M STDIO
FORTRAN/P/M STDOPEN
FORTRAN/P/M SETSETUP
MESSAGE All subroutines needed for KERMIT-RDOS have been compiled
CCCCCCCCCCCCC CONNECT.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE CONNECT
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER ECHAR,T,STATUS,ICHAR,KGETCH,CQ,CS
      CS=011423K
      CQ=010421K
      ECHAR=29
      STATUS=1
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
      T=KGETCH(ICHAR,LOCALINFD)
      IF(.NOT.(T.EQ.0))GOTO 23002
      CALL REMARK("error in I/O using remote TTY")
      CALL REMARK("return to Kermit-RDOS")
      RETURN
23002 CONTINUE
      IF(.NOT.(ICHAR.EQ.ECHAR))GOTO 23004
      CALL REMARK("return to Kermit-RDOS")
      RETURN
23004 CONTINUE
      CALL KPUTCH(ICHAR,RMTOUTFD)
      IF(.NOT.(IBM.EQ.-1))GOTO 23006
      CALL KPUTCH(ICHAR,LOCALOUTFD)
23006 CONTINUE
23005 CONTINUE
      GOTO 23000
23001 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC CTL.FT            CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION CTL(CH)
      INTEGER CH
      CTL=IXOR(CH,100K)
      RETURN
      END
CCCCCCCCCCCCC  EXIT.FT          CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       SUBROUTINE RATEXIT
      COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
     *:15), IC(0:15), MD(0:15)
      INTEGER CHANNEL
      INTEGER APOS
      INTEGER VPOS
      INTEGER LINEBUF
      INTEGER NC
      INTEGER IC
      INTEGER MD
      DO23000 I = 0, 15
      CALL FLUSH (I)
23000 CONTINUE
23001 CONTINUE
      CALL EXIT
      END
CCCCCCCCCCCCC  FINDLN.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION FINDLN(LIN,APAT,A1,Z1)
      IMPLICIT INTEGER (A-Z)
      INTEGER LIN(132)
      INTEGER APAT(128)
      STATUS=-2
      T1=A1
23000 IF(.NOT.(STATUS.EQ.-2))GOTO 23001
23002 IF(.NOT.((LIN(T1).NE.APAT(1).AND.(LIN(T1)).NE.10002)))GOTO 23003
      T1=T1+1
      GOTO 23002
23003 CONTINUE
      IF(.NOT.(LIN(T1).EQ.10002))GOTO 23004
      STATUS=0
      GOTO 23005
23004 CONTINUE
      A1=T1
      T2=1
      T3=T1
      FLAG=0
23006 IF(.NOT.((FLAG.EQ.0).AND.(APAT(T2).NE.10002)))GOTO 23007
      IF(.NOT.(APAT(T2).EQ.LIN(T1)))GOTO 23008
      T1=T1+1
      T2=T2+1
      GOTO 23009
23008 CONTINUE
      FLAG=1
23009 CONTINUE
      GOTO 23006
23007 CONTINUE
      IF(.NOT.(APAT(T2).EQ.10002))GOTO 23010
      Z1=T1-1
      STATUS=1
      GOTO 23011
23010 CONTINUE
      T1=T3+1
23011 CONTINUE
23005 CONTINUE
      GOTO 23000
23001 CONTINUE
      FINDLN=STATUS
      RETURN
      END
CCCCCCCCCCCCC     FLUSH.FT      CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE FLUSH(FD)
      INTEGER FD
      COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
     *:15), IC(0:15), MD(0:15)
      INTEGER CHANNEL
      INTEGER APOS
      INTEGER VPOS
      INTEGER LINEBUF
      INTEGER NC
      INTEGER IC
      INTEGER MD
      IF(.NOT.(0 .LE. FD .AND. FD .LE. 15 .AND. CHANNEL(FD) .NE. 10001))
     *GOTO 23000
      IF(.NOT.(MD(FD) .EQ. 1 .AND. IC(FD) .GT. 1))GOTO 23002
      BYTE(LINEBUF(1,FD),IC(FD)) = 0
      CALL WRLIN (FD, LINEBUF(1,FD), NC(FD), IER)
      CALL CHKIO (FD, IER)
23002 CONTINUE
      IC(FD) = 1
      NC(FD) = 0
23000 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC   GETCH.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       INTEGER FUNCTION GETCH (C, FD)
      INTEGER C, FD
      COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
     *:15), IC(0:15), MD(0:15)
      INTEGER CHANNEL
      INTEGER APOS
      INTEGER VPOS
      INTEGER LINEBUF
      INTEGER NC
      INTEGER IC
      INTEGER MD
      IF(.NOT.(0 .LE. FD .AND. FD .LE. 15 .AND. CHANNEL(FD) .NE. 10001))
     *GOTO 23000
      IF(.NOT.(MD(FD) .NE. 0))GOTO 23002
      MD(FD) = 0
      IC(FD) = 1
      NC(FD) = 0
23002 CONTINUE
23004 CONTINUE
      IF(.NOT.(NC(FD) .LT. IC(FD)))GOTO 23007
      NC(FD) = 0
      CALL RDLIN (FD, LINEBUF(1,FD), NC(FD), IER)
      CALL CHKIO (FD, IER)
      IC(FD) = 1
23007 CONTINUE
      IF(.NOT.(NC(FD) .LT. IC(FD)))GOTO 23009
      C = 10003
      GOTO 23010
23009 CONTINUE
      C = BYTE(LINEBUF(1,FD), IC(FD)) .AND. 177K
      IC(FD) = IC(FD) + 1
      IF(.NOT.(C .EQ. 10))GOTO 23011
      C = 0
      GOTO 23012
23011 CONTINUE
      IF(.NOT.(C .EQ. 13))GOTO 23013
      C = 10
23013 CONTINUE
23012 CONTINUE
23010 CONTINUE
23005 IF(.NOT.(C .EQ. 10003 .OR. C .NE. 0))GOTO 23004
23006 CONTINUE
      GOTO 23001
23000 CONTINUE
      C = 10003
23001 CONTINUE
      GETCH=(C)
      RETURN
      END
CCCCCCCCCCCCC  GETLIN.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       INTEGER FUNCTION GETLIN(LINE, F)
      INTEGER LINE(132), C, GETCH
      INTEGER F
      GETLIN = 0
23000 IF(.NOT.(GETCH(C, F) .NE. 10003))GOTO 23002
      IF(.NOT.(C .EQ. 0))GOTO 23003
      GOTO 23002
23003 CONTINUE
      IF(.NOT.(GETLIN .LT. 132 - 1))GOTO 23005
      GETLIN = GETLIN + 1
      LINE(GETLIN) = C
23005 CONTINUE
      IF(.NOT.(C .EQ. 10 .OR. C .EQ. 12))GOTO 23007
      GOTO 23002
23007 CONTINUE
23001 GOTO 23000
23002 CONTINUE
      LINE(GETLIN+1) = 10002
      IF(.NOT.(GETLIN .EQ. 0 .AND. C .EQ. 10003))GOTO 23009
      GETLIN = 10003
23009 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC   HELPKERMIT      CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 CONNECT          - Enters into the 'CHAT' mode, whatever you typed on the
                  - local keyboard is transmitted to the remote host, and
                  - information from the remote host are transmitted to the
                  - local terminal.  'CHAT' mode is used in establishing
                  - login sessions and invoking remote KERMIT program.
                  - CNTR ] will cause exit from 'CHAT' mode.

 EXIT             - EXIT from this KERMIT program and returns to the CLI.

 HELP             - Displays the content of this help file.

 QUIT             - QUIT from this KERMIT program and returns to the CLI.

 RECEIVE          - Enters the 'RECEIVE' state of file transfer mode,
                  - program waits for in-coming packet with no time-out
                  - detection capability provided.

 SEND             - Enters the 'SEND' state of file transfer mode, programs
                  - will then prompts for either a filename or a directory
                  - of filenames (i.e. @directory) to be transmitted.

 SET IBM OFF      - In 'CHAT' mode, expects remote system to echo back
                  - transmitted characters.  In file transfer mode, does
                  - not wait for the detection of DC1 before sending out
                  - the next packet.

 SET IBM ON       - In 'CHAT' mode, performs local echoing of transmitted
                  - characters.  In file transfer mode, wait for the
                  - detection of DC1 from CMS before sending out the next
                  - packet. The program actually looks for the CMS prompt
                  - of BELL (7).

 STATUS           - Displays the current values of various setting.
CCCCCCCCCCCCC IBMGETLIN.FT      CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION IBMGETLIN(BUFFER,CH)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER BUFFER(132)
      INTEGER CH,IDC1,STATUS,COUNT,IBYTE,T,GETSOH
      IDC1=021K
      IBELL=007K
      STATUS=1
      GETSOH=0
      COUNT=1
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
23002 IF(.NOT.(GETSOH.EQ.0))GOTO 23003
      IBYTE=0
      CALL RDSEQ(CH,IBYTE,1,IER)
      T=ISHIFT(IBYTE,-8) .AND. 177K
      IF(.NOT.(T.EQ.1 ))GOTO 23004
      GETSOH=1
      BUFFER(COUNT)=T
      COUNT=COUNT+1
23004 CONTINUE
      GOTO 23002
23003 CONTINUE
      IBYTE=0
      CALL RDSEQ(CH,IBYTE,1,IER)
      T=ISHIFT(IBYTE,-8) .AND. 177K
      IF(.NOT.(T.EQ.IBELL))GOTO 23006
      STATUS=0
      GOTO 23007
23006 CONTINUE
      BUFFER(COUNT)=T
      COUNT=COUNT+1
23007 CONTINUE
      GOTO 23000
23001 CONTINUE
      BUFFER(COUNT)=10002
      RETURN
      END
CCCCCCCCCCCCC   ITOC.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION ITOC(INT, STR, SIZE)
      INTEGER IABS, MOD
      INTEGER I, INT, INTVAL, J, K, SIZE
      INTEGER STR(10000)
      INTVAL = IABS(INT)
      STR(1) = 10002
      I = 1
23000 CONTINUE
      I = I + 1
      STR(I) = 48 + MOD(INTVAL,10)
      INTVAL = INTVAL / 10
23001 IF(.NOT.(INTVAL .EQ. 0 .OR. I .GE. SIZE))GOTO 23000
23002 CONTINUE
      IF(.NOT.(INT .LT. 0 .AND. I .LT. SIZE))GOTO 23003
      I = I + 1
      STR(I) = 45
23003 CONTINUE
      ITOC = I - 1
      J = 1
23005 IF(.NOT.(J .LT. I))GOTO 23007
      K = STR(I)
      STR(I) = STR(J)
      STR(J) = K
      I = I - 1
23006 J = J + 1
      GOTO 23005
23007 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC   KERMIT.FT       CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     Implemented by John Lee of RCA Laboratories for Data General
C     family of mini-computers running RDOS operating system.
C
C     Permission is granted to any individual or institution to
C     use or copy this program, except for explicitly commercial
C     purpose.
C
C                                               John Lee
C                                               RCA Laboratories
C                                               609-734-3157
C                                               7/9/84
C
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER RESW,X,STATUS,GETLIN,TEMP,AOPEN,AONE,BONE,A1,Z1
      INTEGER ATWO,FINDLN
      INTEGER FLAG1,FLAG2,FLAG3,FLAG4,FLAG5,FLAG6,FLAG7,FLAG8,FLAG9
      INTEGER BELL(3)
      INTEGER INTTY(5)
      INTEGER OUTTTY(5)
      INTEGER ALIN(132)
      INTEGER BLIN(132)
      INTEGER DLIN(132)
      INTEGER SLIN(132)
      INTEGER APAT(128)
      INTEGER BPAT(128)
      INTEGER CPAT(128)
      INTEGER DPAT(128)
      INTEGER EPAT(128)
      INTEGER FPAT(128)
      INTEGER GPAT(128)
      INTEGER HPAT(128)
      INTEGER IPAT(128)
      INTEGER ITTY(132)
      INTEGER OTTY(132)
      INTEGER XREC(8)
      DATA XREC(1),XREC(2),XREC(3),XREC(4),XREC(5),XREC(6),XREC(7),XREC(
     *8)/82,69,67,69,73,86,69,10002/
      INTEGER RMTTTY(6)
      DATA RMTTTY(1),RMTTTY(2),RMTTTY(3),RMTTTY(4),RMTTTY(5),RMTTTY(6)/8
     *1,84,89,58,51,10002/
      INTEGER SSEND(5)
      DATA SSEND(1),SSEND(2),SSEND(3),SSEND(4),SSEND(5)/83,69,78,68,1000
     *2/
      INTEGER HELP(5)
      DATA HELP(1),HELP(2),HELP(3),HELP(4),HELP(5)/72,69,76,80,10002/
      INTEGER SEXIT(5)
      DATA SEXIT(1),SEXIT(2),SEXIT(3),SEXIT(4),SEXIT(5)/69,88,73,84,1000
     *2/
      INTEGER QUIT(5)
      DATA QUIT(1),QUIT(2),QUIT(3),QUIT(4),QUIT(5)/81,85,73,84,10002/
      INTEGER STAT(7)
      DATA STAT(1),STAT(2),STAT(3),STAT(4),STAT(5),STAT(6),STAT(7)/83,84
     *,65,84,85,83,10002/
      INTEGER IBMON(11)
      DATA IBMON(1),IBMON(2),IBMON(3),IBMON(4),IBMON(5),IBMON(6),IBMON(7
     *),IBMON(8),IBMON(9),IBMON(10),IBMON(11)/83,69,84,32,73,66,77,32,79
     *,78,10002/
      INTEGER IBMOFF(12)
      DATA IBMOFF(1),IBMOFF(2),IBMOFF(3),IBMOFF(4),IBMOFF(5),IBMOFF(6),I
     *BMOFF(7),IBMOFF(8),IBMOFF(9),IBMOFF(10),IBMOFF(11),IBMOFF(12)/83,6
     *9,84,32,73,66,77,32,79,70,70,10002/
      INTEGER HELPFILE(11)
      DATA HELPFILE(1),HELPFILE(2),HELPFILE(3),HELPFILE(4),HELPFILE(5),H
     *ELPFILE(6),HELPFILE(7),HELPFILE(8),HELPFILE(9),HELPFILE(10),HELPFI
     *LE(11)/72,69,76,80,75,69,82,77,73,84,10002/
      INTEGER VALUE(41)
      DATA VALUE(1),VALUE(2),VALUE(3),VALUE(4),VALUE(5),VALUE(6),VALUE(7
     *),VALUE(8),VALUE(9),VALUE(10),VALUE(11),VALUE(12),VALUE(13),VALUE(
     *14),VALUE(15),VALUE(16),VALUE(17),VALUE(18),VALUE(19),VALUE(20),VA
     *LUE(21),VALUE(22),VALUE(23),VALUE(24),VALUE(25),VALUE(26),VALUE(27
     *),VALUE(28),VALUE(29),VALUE(30),VALUE(31),VALUE(32),VALUE(33),VALU
     *E(34),VALUE(35),VALUE(36),VALUE(37),VALUE(38),VALUE(39),VALUE(40),
     *VALUE(41)/32,108,111,99,97,108,32,111,102,102,32,32,32,35,32,32,32
     *,32,32,57,52,32,32,32,94,77,32,32,36,84,84,73,32,32,32,32,32,32,32
     *,32,10002/
      INTEGER MOREFILE(9)
      DATA MOREFILE(1),MOREFILE(2),MOREFILE(3),MOREFILE(4),MOREFILE(5),M
     *OREFILE(6),MOREFILE(7),MOREFILE(8),MOREFILE(9)/109,111,114,101,102
     *,105,108,101,10002/
      INTEGER SCONNECT(8)
      DATA SCONNECT(1),SCONNECT(2),SCONNECT(3),SCONNECT(4),SCONNECT(5),S
     *CONNECT(6),SCONNECT(7),SCONNECT(8)/67,79,78,78,69,67,84,10002/
      CALL STDOPEN
      MOREFD=-1
      STATE=67
      BELL(1)='<BEL><BEL>'
      BELL(2)='<BEL><BEL>'
      BELL(3)='<BEL><BEL>'
      IBM=0
      HOST=-1
      AONE=1
      BONE=1
      ATWO=2
      LOCALINFD=0
      LOCALOUTFD=1
      CALL SCOPY(HELP,AONE,APAT,BONE)
      CALL SCOPY(SEXIT,AONE,BPAT,BONE)
      CALL SCOPY(QUIT,AONE,CPAT,BONE)
      CALL SCOPY(STAT,AONE,DPAT,BONE)
      CALL SCOPY(IBMON,AONE,EPAT,BONE)
      CALL SCOPY(IBMOFF,AONE,FPAT,BONE)
      CALL SCOPY(SSEND,AONE,GPAT,BONE)
      CALL SCOPY(XREC,AONE,HPAT,BONE)
      CALL SCOPY(SCONNECT,AONE,IPAT,BONE)
      CALL SCOPY(VALUE,AONE,SLIN,BONE)
      CALL REMARK("KERMIT-RDOS Version 1.0")
      HOST=0
      CALL REMARK("Local kermit now in effect")
      RMTINFD=RATOPEN(RMTTTY,0)
      IF(.NOT.(RMTINFD.EQ.10001))GOTO 23000
      CALL CANT(RMTTTY)
23000 CONTINUE
      RMTOUTFD=RATOPEN(RMTTTY,1)
      IF(.NOT.(RMTOUTFD.EQ.10001))GOTO 23002
      CALL CANT(RMTTTY)
23002 CONTINUE
      ISTAT=1
23004 IF(.NOT.(ISTAT.EQ.1))GOTO 23005
      CALL WRSEQ(LOCALOUTFD,"Kermit-RDOS>",12,IER)
      FD=10001
      STATUS=GETLIN(ALIN,LOCALINFD)
      CALL UPPER(ALIN,BLIN)
      A1=1
      FLAG1=FINDLN(BLIN,APAT,A1,Z1)
      A1=1
      FLAG2=FINDLN(BLIN,BPAT,A1,Z1)
      A1=1
      FLAG3=FINDLN(BLIN,CPAT,A1,Z1)
      A1=1
      FLAG4=FINDLN(BLIN,DPAT,A1,Z1)
      A1=1
      FLAG5=FINDLN(BLIN,EPAT,A1,Z1)
      A1=1
      FLAG6=FINDLN(BLIN,FPAT,A1,Z1)
      A1=1
      FLAG7=FINDLN(BLIN,GPAT,A1,Z1)
      A1=1
      FLAG8=FINDLN(BLIN,HPAT,A1,Z1)
      A1=1
      FLAG9=FINDLN(BLIN,IPAT,A1,Z1)
      IF(.NOT.(FLAG1.EQ.1))GOTO 23006
      TEMP=RATOPEN(HELPFILE,0)
23008 IF(.NOT.((GETLIN(ALIN,TEMP).NE.10003)))GOTO 23009
      CALL PUTLIN(ALIN,LOCALOUTFD)
      GOTO 23008
23009 CONTINUE
      CALL RATCLOSE(TEMP)
      GOTO 23007
23006 CONTINUE
      IF(.NOT.((FLAG2.EQ.1).OR.(FLAG3.EQ.1)))GOTO 23010
      CALL REMARK("Kermit now terminated")
      CALL RATEXIT
      GOTO 23011
23010 CONTINUE
      IF(.NOT.(FLAG4.EQ.1))GOTO 23012
      CALL REMARK("                 PACKET ")
      CALL REMARK(" MODE  IBM QUOTE  SIZE  EOL TTY    SPEED STATE")
      CALL REMARK(" ")
      IF(.NOT.(HOST.EQ.-1))GOTO 23014
      SLIN(2)=104
      SLIN(3)=111
      SLIN(4)=115
      SLIN(5)=116
      SLIN(6)=32
      GOTO 23015
23014 CONTINUE
      SLIN(2)=108
      SLIN(3)=111
      SLIN(4)=99
      SLIN(5)=97
      SLIN(6)=108
23015 CONTINUE
      IF(.NOT.(IBM.EQ.-1))GOTO 23016
      SLIN(8)=111
      SLIN(9)=110
      SLIN(10)=32
      SLIN(11)=32
      GOTO 23017
23016 CONTINUE
      SLIN(8)=111
      SLIN(9)=102
      SLIN(10)=102
      SLIN(11)=32
23017 CONTINUE
      IF(.NOT.(HOST.EQ.-1))GOTO 23018
      SLIN(29)=36
      SLIN(30)=84
      SLIN(31)=84
      SLIN(32)=73
      SLIN(33)=32
      SLIN(34)=32
      GOTO 23019
23018 CONTINUE
      SLIN(29)=81
      SLIN(30)=84
      SLIN(31)=89
      SLIN(32)=58
      SLIN(33)=51
      SLIN(34)=32
      SLIN(35)=32
      SLIN(36)=57
      SLIN(37)=54
      SLIN(38)=48
      SLIN(39)=48
      SLIN(40)=32
23019 CONTINUE
      SLIN(41)=32
      SLIN(42)=32
      SLIN(43)=32
      SLIN(44)=STATE
      SLIN(45)=32
      SLIN(46)=32
      SLIN(47)=13
      SLIN(48)=10002
      CALL PUTLIN(SLIN,LOCALOUTFD)
      CALL REMARK(" ")
      GOTO 23013
23012 CONTINUE
      IF(.NOT.(FLAG5.EQ.1))GOTO 23020
      IF(.NOT.(HOST.EQ.-1))GOTO 23022
      CALL REMARK("Not supported in host kermit mode")
      GOTO 23023
23022 CONTINUE
      IBM=-1
23023 CONTINUE
      GOTO 23021
23020 CONTINUE
      IF(.NOT.(FLAG6.EQ.1))GOTO 23024
      IBM=0
      GOTO 23025
23024 CONTINUE
      IF(.NOT.(FLAG7.EQ.1))GOTO 23026
      ITEMP=0
      CALL REMARK("enter filename or @filename")
      STATUS=GETLIN(ALIN,0)
      CALL REMOVE(MOREFILE)
      MOREFD=RATOPEN(MOREFILE,1)
      IF(.NOT.(MOREFD.EQ.10001))GOTO 23028
      CALL CANT(MOREFILE)
23028 CONTINUE
      IF(.NOT.(ALIN(1).NE.64))GOTO 23030
      CALL PUTLIN(ALIN,MOREFD)
      GOTO 23031
23030 CONTINUE
      CALL SCOPY(ALIN,ATWO,DLIN,AONE)
      J=1
23032 IF(.NOT.(DLIN(J).NE.10002))GOTO 23033
      IF(.NOT.(DLIN(J).EQ.10))GOTO 23034
      DLIN(J)=13
23034 CONTINUE
      J=J+1
      GOTO 23032
23033 CONTINUE
      ITEMP=RATOPEN(DLIN,0)
      IF(.NOT.(ITEMP.EQ.10001))GOTO 23036
      CALL REMARK("Indirect Source file not found")
      GOTO 23037
23036 CONTINUE
      I=1
23038 IF(.NOT.(I.EQ.1))GOTO 23039
      J=GETLIN(ALIN,ITEMP)
      IF(.NOT.(J.NE.10003))GOTO 23040
      CALL PUTLIN(ALIN,MOREFD)
      GOTO 23041
23040 CONTINUE
      I=0
23041 CONTINUE
      GOTO 23038
23039 CONTINUE
      CALL RATCLOSE(ITEMP)
23037 CONTINUE
23031 CONTINUE
      CALL RATCLOSE(MOREFD)
      IF(.NOT.(ITEMP.NE.10001))GOTO 23042
      IF(.NOT.(HOST.EQ.-1))GOTO 23044
      CALL WAIT(15,2,IER)
23044 CONTINUE
      STATUS=SENDSW(X)
      IF(.NOT.(HOST.EQ.0))GOTO 23046
      CALL WRSEQ(LOCALOUTFD,BELL(1),6,IER)
23046 CONTINUE
      CALL REMARK(" ")
      IF(.NOT.((STATUS.EQ.-1).AND.(HOST.EQ.0)))GOTO 23048
      CALL REMARK("COMPLETED")
23048 CONTINUE
      IF(.NOT.((STATUS.NE.-1).AND.(HOST.EQ.0)))GOTO 23050
      CALL REMARK("FAILED")
23050 CONTINUE
      CALL REMARK(" ")
      IF(.NOT.(FD.NE.10001))GOTO 23052
      CALL RATCLOSE(FD)
23052 CONTINUE
23042 CONTINUE
      GOTO 23027
23026 CONTINUE
      IF(.NOT.(FLAG8.EQ.1))GOTO 23054
      STATUS=RECSW(X)
      IF(.NOT.(HOST.EQ.0))GOTO 23056
      CALL WRSEQ(LOCALOUTFD,BELL(1),6,IER)
23056 CONTINUE
      CALL REMARK(" ")
      IF(.NOT.((STATUS.EQ.-1).AND.(HOST.EQ.0)))GOTO 23058
      CALL REMARK("COMPLETED")
23058 CONTINUE
      IF(.NOT.((STATUS.NE.-1).AND.(HOST.EQ.0)))GOTO 23060
      CALL REMARK("FAILED")
23060 CONTINUE
      CALL REMARK(" ")
      IF(.NOT.(FD.NE.10001))GOTO 23062
      CALL RATCLOSE(FD)
23062 CONTINUE
      GOTO 23055
23054 CONTINUE
      IF(.NOT.(FLAG9.EQ.1))GOTO 23064
      IF(.NOT.(HOST.EQ.-1))GOTO 23066
      CALL REMARK("Connect is not supported in Host mode")
      GOTO 23067
23066 CONTINUE
      TASK KPICK, ID=1, PRI=1
      CALL CONNECT
      CALL TIDK(1,IER)
      CALL CHECK(IER)
      CALL WAIT(2,2,IER)
      CALL RATCLOSE(RMTINFD)
      CALL RATCLOSE(RMTOUTFD)
      RMTINFD=RATOPEN(RMTTTY,0)
      IF(.NOT.(RMTINFD.EQ.10001))GOTO 23068
      CALL CANT(RMTTTY)
23068 CONTINUE
      RMTOUTFD=RATOPEN(RMTTTY,1)
      IF(.NOT.(RMTOUTFD.EQ.10001))GOTO 23070
      CALL CANT(RMTTTY)
23070 CONTINUE
23067 CONTINUE
      GOTO 23065
23064 CONTINUE
      CALL REMARK("Invalid command, please type HELP")
23065 CONTINUE
23055 CONTINUE
23027 CONTINUE
23025 CONTINUE
23021 CONTINUE
23013 CONTINUE
23011 CONTINUE
23007 CONTINUE
      GOTO 23004
23005 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  KGETCH.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION KGETCH(T,XCHAN)
      INTEGER T,XCHAN,X,IER
      CALL RDSEQ(XCHAN,X,1,IER)
      IF(.NOT.(IER.NE.1))GOTO 23000
      GOTO 100
23000 CONTINUE
      T=ISHIFT(X,-8) .AND. 177K
      KGETCH=1
      RETURN
100   CONTINUE
      KGETCH=0
      RETURN
      END
CCCCCCCCCCCCC  KGETLIN.FT       CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION KGETLIN(BUFFER,CH)
      IMPLICIT INTEGER (A-Z)
      INTEGER BUFFER(132)
      INTEGER CH,KGETCH,STATUS,T,COUNT,TEMP
      STATUS=1
      COUNT=1
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
      TEMP=KGETCH(T,CH)
      BUFFER(COUNT)=T
      IF(.NOT.(T.EQ.13))GOTO 23002
      BUFFER(COUNT+1)=10002
      RETURN
23002 CONTINUE
      COUNT=COUNT+1
23003 CONTINUE
      GOTO 23000
23001 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC    KPICK.FT       CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE KPICK
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER IBYTE,STATUS,CS,CQ,COUNT
      INTEGER ALIN(132)
      CS=011423K
      CQ=010421K
      STATUS=1
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
      CALL RDSEQ(RMTINFD,IBYTE,1,IER)
      CALL WRSEQ(LOCALOUTFD,IBYTE,1,IER)
      GOTO 23000
23001 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  KPUTCH.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE KPUTCH(T,CHAN)
      INTEGER T
      INTEGER CH,IER,X
      X=ISHIFT(T,8)
      CALL WRSEQ(CHAN,X,1,IER)
      IF(.NOT.(IER.NE.1))GOTO 23000
      TYPE "error in kputch ",IER
23000 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  LINKALL.LD       CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
/KERMIT.LD

DELETE KERMIT.MP
RLDR/P/D/N/E KERMIT/S KERMIT.MP/L 4/K 17/C ^
kermit rpack spack sinit sfile verify rpar spar recsw bufill bufemp ^
rfile seof sdata ibmgetlin kgetch rinit sendsw kpick rdata ^
tochar kputch findln connect sbreak unchar ^
kgetlin ctl upper stdopen stdio stdsetup remove open close cant ^
remark exit putdec putint putc getlin putlin putstr getch putch flush ^
chkio itoc length scopy pack sscopy ^
@TFLIBLONG@
CCCCCCCCCCCCC  LENGTH.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       INTEGER FUNCTION LENGTH(STR)
      INTEGER STR(10000)
      LENGTH = 0
23000 IF(.NOT.(STR(LENGTH+1) .NE. 10002))GOTO 23002
23001 LENGTH = LENGTH + 1
      GOTO 23000
23002 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  OPEN.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RATOPEN (NAME, MODE)
      INTEGER NAME(10000)
      INTEGER MODE
      COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
     *:15), IC(0:15), MD(0:15)
      INTEGER CHANNEL
      INTEGER APOS
      INTEGER VPOS
      INTEGER LINEBUF
      INTEGER NC
      INTEGER IC
      INTEGER MD
      INTEGER STRING(40), CH
      I = 1
23000 IF(.NOT.(NAME(I) .EQ. 32))GOTO 23002
23001 I = I+1
      GOTO 23000
23002 CONTINUE
      J = 1
23003 IF(.NOT.(NAME(I) .NE. 10002))GOTO 23005
      BYTE(STRING,J) = NAME(I)
      J = J+1
23004 I = I+1
      GOTO 23003
23005 CONTINUE
      BYTE(STRING,J) = 0
      CH = 0
23006 IF(.NOT.(CH .LE. 15))GOTO 23008
      IF(.NOT.(CHANNEL(CH) .EQ. 10001))GOTO 23009
      GOTO 23008
23009 CONTINUE
23007 CH = CH+1
      GOTO 23006
23008 CONTINUE
      IF(.NOT.(CH .GT. 15))GOTO 23011
      IER = 10001
      GOTO 23012
23011 CONTINUE
      IF(.NOT.(MODE .EQ. 0))GOTO 23013
      CALL OPEN (CH, STRING, 1, IER)
      GOTO 23014
23013 CONTINUE
      IF(.NOT.(MODE .EQ. 1 .OR. MODE .EQ. 2))GOTO 23015
      CALL CFILW (STRING, 2, IER)
      CALL OPEN (CH, STRING, 3, IER)
23015 CONTINUE
23014 CONTINUE
23012 CONTINUE
      IF(.NOT.(IER .NE. 1))GOTO 23017
      WRITE (2, 1) IER, CH, MODE, STRING(1)
1     FORMAT(" open error=",I5,", ch=",I2, ", mode=",I2,", file=",S20)
      CH = 10001
      GOTO 23018
23017 CONTINUE
      CHANNEL(CH) = MODE
23018 CONTINUE
      RATOPEN=(CH)
      RETURN
      END
CCCCCCCCCCCCC     PACK.FT       CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION PACK (RSTRING, STRING, MAX0)
      INTEGER STRING(10000), RSTRING(MAX0)
      I = 1
23000 IF(.NOT.(I .LT. MAX0))GOTO 23002
      BYTE(STRING,I) = RSTRING(I)
      IF(.NOT.(RSTRING(I) .EQ. 10002))GOTO 23003
      GOTO 23002
23003 CONTINUE
23001 I = I + 1
      GOTO 23000
23002 CONTINUE
      BYTE(STRING,I) = 0
      PACK=(I-1)
      RETURN
      END
CCCCCCCCCCCCC   PUTC.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       SUBROUTINE PUTC(C)
      INTEGER C
      CALL PUTCH(C, 1)
      RETURN
      END
CCCCCCCCCCCCC  PUTCH.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       SUBROUTINE PUTCH (C, FD)
      INTEGER C, FD
      COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
     *:15), IC(0:15), MD(0:15)
      INTEGER CHANNEL
      INTEGER APOS
      INTEGER VPOS
      INTEGER LINEBUF
      INTEGER NC
      INTEGER IC
      INTEGER MD
      IF(.NOT.(0 .LE. FD .AND. FD .LE. 15 .AND. CHANNEL(FD) .NE. 10001))
     *GOTO 23000
      IF(.NOT.(MD(FD) .NE. 1))GOTO 23002
      MD(FD) = 1
      IC(FD) = 1
      NC(FD) = 0
23002 CONTINUE
      IF(.NOT.(C .EQ. 10))GOTO 23004
      BYTE(LINEBUF(1,FD),IC(FD)) = 13
      IC(FD) = IC(FD) + 1
      CALL FLUSH (FD)
      GOTO 23005
23004 CONTINUE
      BYTE(LINEBUF(1,FD),IC(FD)) = C
      IC(FD) = IC(FD) + 1
      IF(.NOT.(IC(FD) .GT. 132 .OR. C .EQ. 13))GOTO 23006
      CALL WRSEQ (FD, LINEBUF(1,FD), IC(FD), IER)
      CALL CHKIO (FD, IER)
      IC(FD) = 1
      GOTO 23007
23006 CONTINUE
      IF(.NOT.(C .EQ. 12 .OR. C .EQ. 0))GOTO 23008
      CALL FLUSH (FD)
23008 CONTINUE
23007 CONTINUE
23005 CONTINUE
23000 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC    PUTDEC.FT      CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       SUBROUTINE PUTDEC(N, W)
      INTEGER N, W
      CALL PUTINT(N, W, 1)
      RETURN
      END
CCCCCCCCCCCCC  PUTINT.FT      CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       SUBROUTINE PUTINT(N, W, F)
      INTEGER N, W, F
      INTEGER CHARS(10)
      INTEGER ITOC
      INTEGER JUNK
      JUNK = ITOC(N, CHARS, 10)
      CALL PUTSTR(CHARS, W, F)
      RETURN
      END
CCCCCCCCCCCCC   PUTLIN.FT       CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       SUBROUTINE PUTLIN(B, F)
      INTEGER B(10000)
      INTEGER F, I
      I = 1
23000 IF(.NOT.(B(I) .NE. 10002))GOTO 23002
      CALL PUTCH(B(I), F)
23001 I = I + 1
      GOTO 23000
23002 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  PUTSTR.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       SUBROUTINE PUTSTR(STR, W, F)
      INTEGER STR(132)
      INTEGER W, F, LEN, I, LENGTH
      LEN = LENGTH(STR)
      IF(.NOT.(W .GE. 0))GOTO 23000
      I = LEN + 1
23002 IF(.NOT.(I .LE. W))GOTO 23004
      CALL PUTCH(32, F)
23003 I = I + 1
      GOTO 23002
23004 CONTINUE
23000 CONTINUE
      I = 1
23005 IF(.NOT.(STR(I) .NE. 10002))GOTO 23007
      CALL PUTCH(STR(I), F)
23006 I = I + 1
      GOTO 23005
23007 CONTINUE
      IF(.NOT.(W .LT. 0))GOTO 23008
      I = LEN + 1
23010 IF(.NOT.(I .LE. -W))GOTO 23012
      CALL PUTCH(32, F)
23011 I = I + 1
      GOTO 23010
23012 CONTINUE
23008 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  RDATA.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RDATA(X)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER NUM,LEN,STATUS
      INTEGER X,RPACK,TNUM
      INTEGER XPACK(10)
      DATA XPACK(1),XPACK(2),XPACK(3),XPACK(4),XPACK(5),XPACK(6),XPACK(7
     *),XPACK(8),XPACK(9),XPACK(10)/80,97,99,107,101,116,32,35,32,10002/
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      RDATA=65
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      STATUS=RPACK(LEN,NUM,PACKET)
      IF(.NOT.(HOST.EQ.0))GOTO 23002
      CALL PUTDEC(NUM,4)
      CALL PUTC(13)
      CALL FLUSH(1)
23002 CONTINUE
      IF(.NOT.(STATUS.EQ.68))GOTO 23004
      IF(.NOT.(NUM.NE.N))GOTO 23006
      IF(.NOT.(OLDTRY.GT.5 ))GOTO 23008
      RDATA=65
      RETURN
23008 CONTINUE
      OLDTRY=OLDTRY+1
23009 CONTINUE
      IF(.NOT.(NUM.EQ.(N-1)))GOTO 23010
      CALL SPAR(PACKET)
      CALL SPACK(89,NUM,6,PACKET)
      NUMTRY=0
      RDATA=STATE
      RETURN
23010 CONTINUE
      RDATA=65
      RETURN
23011 CONTINUE
23006 CONTINUE
      CALL BUFEMP(PACKET,LEN)
      TNUM=N
      CALL SPACK(89,TNUM,0,0)
      OLDTRY=NUMTRY
      NUMTRY=0
      N=MOD((N+1),64)
      RDATA=68
      RETURN
23004 CONTINUE
      IF(.NOT.(STATUS.EQ.70))GOTO 23012
      IF(.NOT.(OLDTRY.GT.5 ))GOTO 23014
      RDATA=65
      RETURN
23014 CONTINUE
      OLDTRY=OLDTRY+1
23015 CONTINUE
      IF(.NOT.(NUM.EQ.(N-1)))GOTO 23016
      CALL SPACK(89,NUM,0,0)
      NUMTRY=0
      RDATA=STATE
      RETURN
23016 CONTINUE
      RDATA=65
      RETURN
23017 CONTINUE
      GOTO 23013
23012 CONTINUE
      IF(.NOT.(STATUS.EQ.90))GOTO 23018
      IF(.NOT.(NUM.NE.N))GOTO 23020
      RDATA=65
      RETURN
23020 CONTINUE
      TNUM=N
      CALL SPACK(89,TNUM,0,0)
      CALL RATCLOSE(FD)
      N=MOD((N+1),64)
      RDATA=70
      RETURN
23018 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23022
      RDATA=STATE
      TNUM=N
      CALL SPACK(78,TNUM,0,0)
      RETURN
23022 CONTINUE
      RDATA=65
23023 CONTINUE
23019 CONTINUE
23013 CONTINUE
23005 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC   RECSW.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RECSW(X)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER X
      INTEGER RDATA,RFILE,RINIT,STATUS
      STATUS=1
      STATE=82
      N=0
      NUMTRY=0
      EOL=13
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
      IF(.NOT.(STATE.EQ.68))GOTO 23002
      STATE=RDATA(X)
      GOTO 23003
23002 CONTINUE
      IF(.NOT.(STATE.EQ.70))GOTO 23004
      STATE=RFILE(X)
      GOTO 23005
23004 CONTINUE
      IF(.NOT.(STATE.EQ.82))GOTO 23006
      STATE=RINIT(X)
      GOTO 23007
23006 CONTINUE
      IF(.NOT.(STATE.EQ.67))GOTO 23008
      RECSW=-1
      RETURN
23008 CONTINUE
      IF(.NOT.(STATE.EQ.65))GOTO 23010
      RECSW=0
      RETURN
23010 CONTINUE
23009 CONTINUE
23007 CONTINUE
23005 CONTINUE
23003 CONTINUE
      GOTO 23000
23001 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  REMARK.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       SUBROUTINE REMARK (STRING)
      INTEGER STRING
      INTEGER C
      I=1
23000 CONTINUE
      C = BYTE(STRING,I)
      IF(.NOT.(C .EQ. 0))GOTO 23003
      GOTO 23002
23003 CONTINUE
      CALL PUTCH (C, 2)
23001 I=I+1
      GOTO 23000
23002 CONTINUE
      CALL PUTCH (10, 2)
      RETURN
      END
CCCCCCCCCCCCC   REMOVE.FT    CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       SUBROUTINE REMOVE(NAME)
      INTEGER NAME(50)
      INTEGER PNAME(50)
      INTEGER PACK, IER
      IER = PACK (NAME, PNAME, 50)
      CALL DFILW (PNAME, IER)
      RETURN
      END
CCCCCCCCCCCCC  RFILE.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RFILE(X)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER NUM,LEN,STATUS,RPACK,X,TNUM
      INTEGER AONE,BONE,A12
      INTEGER ALIN(132)
      INTEGER RECEIVING(12)
      DATA RECEIVING(1),RECEIVING(2),RECEIVING(3),RECEIVING(4),RECEIVING
     *(5),RECEIVING(6),RECEIVING(7),RECEIVING(8),RECEIVING(9),RECEIVING(
     *10),RECEIVING(11),RECEIVING(12)/32,82,101,99,101,105,118,105,110,1
     *03,32,10002/
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      RFILE=65
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      STATUS=RPACK(LEN,NUM,PACKET)
      IF(.NOT.(STATUS.EQ.83))GOTO 23002
      IF(.NOT.(OLDTRY.GT.5 ))GOTO 23004
      RFILE=65
      RETURN
23004 CONTINUE
      OLDTRY=OLDTRY+1
23005 CONTINUE
      IF(.NOT.(NUM.EQ.(N-1)))GOTO 23006
      CALL SPAR(PACKET)
      CALL SPACK(89,NUM,6,PACKET)
      NUMTRY=0
      RFILE=STATE
      RETURN
23006 CONTINUE
      RFILE=65
      RETURN
23007 CONTINUE
      GOTO 23003
23002 CONTINUE
      IF(.NOT.(STATUS.EQ.90))GOTO 23008
      IF(.NOT.(OLDTRY.GT.5 ))GOTO 23010
      RFILE=65
      RETURN
23010 CONTINUE
      OLDTRY=OLDTRY+1
23011 CONTINUE
      IF(.NOT.(NUM.EQ.(N-1)))GOTO 23012
      CALL SPACK(89,NUM,0,0)
      NUMTRY=0
      RFILE=STATE
      RETURN
23012 CONTINUE
      RFILE=65
      RETURN
23013 CONTINUE
      GOTO 23009
23008 CONTINUE
      IF(.NOT.(STATUS.EQ.70))GOTO 23014
      IF(.NOT.(NUM.NE.N))GOTO 23016
      RFILE=65
      RETURN
23016 CONTINUE
      PACKET(LEN+1)=13
      PACKET(LEN+2)=10002
      CALL VERIFY(PACKET)
      IF(.NOT.(HOST.EQ.0))GOTO 23018
      AONE=1
      BONE=1
      A12=12
      CALL SCOPY(RECEIVING,AONE,ALIN,BONE)
      CALL SCOPY(PACKET,AONE,ALIN,A12)
      CALL PUTLIN(ALIN,LOCALOUTFD)
      ALIN(1)=10
      ALIN(2)=10002
      CALL PUTLIN(ALIN,LOCALOUTFD)
      CALL REMARK(" Packet # ")
23018 CONTINUE
      FD=RATOPEN(PACKET,1)
      IF(.NOT.(FD.EQ.10001))GOTO 23020
      CALL CANT(PACKET)
      RFILE=65
      RETURN
23020 CONTINUE
      TNUM=N
      CALL SPACK(89,TNUM,0,0)
      ODLTRY=NUMTRY
      NUMTRY=0
      N=MOD((N+1),64)
      RFILE=68
      RETURN
23014 CONTINUE
      IF(.NOT.(STATUS.EQ.66))GOTO 23022
      IF(.NOT.(NUM.NE.N))GOTO 23024
      RFILE=65
      RETURN
23024 CONTINUE
      TNUM=N
      CALL SPACK(89,TNUM,0,0)
      RFILE=67
      RETURN
23022 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23026
      RFILE=STATE
      TNUM=N
      CALL SPACK(78,TNUM,0,0)
      RETURN
23026 CONTINUE
      RFILE=65
23027 CONTINUE
23023 CONTINUE
23015 CONTINUE
23009 CONTINUE
23003 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC    RINIT.FT       CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RINIT(X)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER LEN,NUM,STATUS,RPACK,X,TNUM
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      RINIT=65
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      STATUS=RPACK(LEN,NUM,PACKET)
      IF(.NOT.(STATUS.EQ.83))GOTO 23002
      CALL RPAR(PACKET)
      CALL SPAR(PACKET)
      TNUM=N
      CALL SPACK(89,TNUM,6,PACKET)
      OLDTRY=NUMTRY
      NUMTRY=0
      N=MOD((N+1),64)
      RINIT=70
      RETURN
23002 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23004
      RINIT=STATE
      TNUM=N
      CALL SPACK(78,TNUM,0,0)
      RETURN
23004 CONTINUE
      RINIT=65
23005 CONTINUE
23003 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  RPACK.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RPACK(LEN,NUM,XDATA)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER LEN,NUM,CH
      INTEGER KGETLIN,IBMGETLIN
      INTEGER XDATA(1)
      INTEGER I,COUNT,STATUS,UNCHAR,J,K,IDC1,T1,IBYTE
      INTEGER XCOUNT,TEMP,MAILID
      INTEGER CHKSUM,T,XTYPE,BUFFER(132)
      IDC1=03400K
      CHKSUM=0
      IF(.NOT.(IBM.EQ.-1))GOTO 23000
      XCOUNT=8
      GOTO 23001
23000 CONTINUE
      XCOUNT=2
23001 CONTINUE
      I=1
      CH=RMTINFD
23002 IF(.NOT.(I.LE.XCOUNT))GOTO 23003
      IF(.NOT.(IBM.EQ.-1))GOTO 23004
      STATUS=IBMGETLIN(BUFFER,CH)
      GOTO 23005
23004 CONTINUE
      STATUS=KGETLIN(BUFFER,CH)
23005 CONTINUE
      COUNT=1
23006 IF(.NOT.((BUFFER(COUNT).NE.1 ).AND.(BUFFER(COUNT).NE.10002)))GOTO
     *23007
      COUNT=COUNT+1
      GOTO 23006
23007 CONTINUE
      IF(.NOT.(BUFFER(COUNT).EQ.1 ))GOTO 23008
      K=COUNT+1
      CHKSUM=BUFFER(K)
      LEN=UNCHAR(BUFFER(K))-3
      K=K+1
      CHKSUM=CHKSUM+BUFFER(K)
      NUM=UNCHAR(BUFFER(K))
      K=K+1
      XTYPE=BUFFER(K)
      CHKSUM=CHKSUM+BUFFER(K)
      K=K+1
      J=1
23010 IF(.NOT.(J.LE.LEN))GOTO 23012
      XDATA(J)=BUFFER(K)
      CHKSUM=CHKSUM+BUFFER(K)
      K=K+1
      COUNT=J
23011 J=J+1
      GOTO 23010
23012 CONTINUE
      XDATA(COUNT+1)=0
      T=BUFFER(K)
      CHKSUM=(CHKSUM+(CHKSUM.AND.192)/64).AND.63
      IF(.NOT.(CHKSUM.NE.UNCHAR(T)))GOTO 23013
      RPACK=0
      RETURN
23013 CONTINUE
      RPACK=XTYPE
      RETURN
23008 CONTINUE
      I=I+1
      GOTO 23002
23003 CONTINUE
      RPACK=0
      RETURN
      END
CCCCCCCCCCCCC   RPAR.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE RPAR(XDATA)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER XDATA(1)
      INTEGER UNCHAR,CTL
      SPSIZ=UNCHAR(XDATA(1))
      PAD=UNCHAR(XDATA(3))
      PADCHAR=CTL(XDATA(4))
      EOL=UNCHAR(XDATA(5))
      QUOTE=XDATA(6)
      RETURN
      END
CCCCCCCCCCCCC SBREAK.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SBREAK(X)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER NUM,LEN,RPACK,STATUS,X,TNUM
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      SBREAK=65
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      TNUM=N
      CALL SPACK(66,TNUM,0,PACKET)
      STATUS=RPACK(LEN,NUM,RECPKT)
      IF(.NOT.(STATUS.EQ.78))GOTO 23002
      IF(.NOT.(N.NE.(NUM-1)))GOTO 23004
      SBREAK=STATE
      RETURN
23004 CONTINUE
      GOTO 23003
23002 CONTINUE
      IF(.NOT.(STATUS.EQ.89))GOTO 23006
      IF(.NOT.(N.NE.NUM))GOTO 23008
      SBREAK=STATE
      RETURN
23008 CONTINUE
      NUMTRY=0
      N=MOD((N+1),64)
      SBREAK=67
      RETURN
23006 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23010
      SBREAK=STATE
      RETURN
23010 CONTINUE
      SBREAK=65
23011 CONTINUE
23007 CONTINUE
23003 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC   SCOPY.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       SUBROUTINE SCOPY(FROM, I, TO, J)
      INTEGER FROM(10000), TO(10000)
      INTEGER I, J, K1, K2
      K2 = J
      K1 = I
23000 IF(.NOT.(FROM(K1) .NE. 10002))GOTO 23002
      TO(K2) = FROM(K1)
      K2 = K2 + 1
23001 K1 = K1 + 1
      GOTO 23000
23002 CONTINUE
      TO(K2) = 10002
      RETURN
      END
CCCCCCCCCCCCC  SDATA.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SDATA(X)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER XPACK(10)
      DATA XPACK(1),XPACK(2),XPACK(3),XPACK(4),XPACK(5),XPACK(6),XPACK(7
     *),XPACK(8),XPACK(9),XPACK(10)/80,97,99,107,101,116,32,35,32,10002/
      INTEGER X,NUM,LEN,BUFILL,STATUS,RPACK,TNUM
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      SDATA=65
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      TNUM=N
      CALL SPACK(68,TNUM,SIZE,PACKET)
      IF(.NOT.(HOST.EQ.0))GOTO 23002
      CALL PUTDEC(NUM,4)
      CALL PUTC(13)
      CALL FLUSH(1)
23002 CONTINUE
      STATUS=RPACK(LEN,NUM,RECPKT)
      IF(.NOT.((STATUS.EQ.89).AND.(N.EQ.(NUM+1))))GOTO 23004
      STATUS=RPACK(LEN,NUM,RECPKT)
23004 CONTINUE
      IF(.NOT.(STATUS.EQ.78))GOTO 23006
      IF(.NOT.(N.NE.(NUM-1)))GOTO 23008
      SDATA=STATE
      RETURN
23008 CONTINUE
      GOTO 23007
23006 CONTINUE
      IF(.NOT.(STATUS.EQ.89))GOTO 23010
      IF(.NOT.(N.NE.NUM))GOTO 23012
      SDATA=STATE
      RETURN
23012 CONTINUE
      NUMTRY=0
      N=MOD((N+1),64)
      SIZE=BUFILL(PACKET)
      IF(.NOT.(SIZE.EQ.10003))GOTO 23014
      SDATA=90
      RETURN
23014 CONTINUE
      SDATA=68
      RETURN
23010 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23016
      SDATA=STATE
      RETURN
23016 CONTINUE
      SDATA=65
23017 CONTINUE
23011 CONTINUE
23007 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC SENDSW.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SENDSW(X)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER X,STATUS
      INTEGER SDATA,SFILE,SEOF,SINIT,SBREAK
      STATE=83
      N=0
      EOL=13
      NUMTRY=0
      STATUS=1
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
      IF(.NOT.(STATE.EQ.68))GOTO 23002
      STATE=SDATA(X)
      GOTO 23003
23002 CONTINUE
      IF(.NOT.(STATE.EQ.70))GOTO 23004
      STATE=SFILE(X)
      GOTO 23005
23004 CONTINUE
      IF(.NOT.(STATE.EQ.90))GOTO 23006
      STATE=SEOF(X)
      GOTO 23007
23006 CONTINUE
      IF(.NOT.(STATE.EQ.83))GOTO 23008
      STATE=SINIT(X)
      GOTO 23009
23008 CONTINUE
      IF(.NOT.(STATE.EQ.66))GOTO 23010
      STATE=SBREAK(X)
      GOTO 23011
23010 CONTINUE
      IF(.NOT.(STATE.EQ.67))GOTO 23012
      SENDSW=-1
      RETURN
23012 CONTINUE
      IF(.NOT.(STATE.EQ.65))GOTO 23014
      SENDSW=0
      RETURN
23014 CONTINUE
      STATUS=0
      SENDSW=0
23015 CONTINUE
23013 CONTINUE
23011 CONTINUE
23009 CONTINUE
23007 CONTINUE
23005 CONTINUE
23003 CONTINUE
      GOTO 23000
23001 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC    SEOF.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SEOF(X)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER NUM,LEN,STATUS,RPACK,X,TNUM,TEMP
      INTEGER XY
      INTEGER ALIN(132)
      INTEGER AONE,BONE
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      SEOF=65
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      AONE=1
      BONE=1
      TNUM=N
      CALL SPACK(90,TNUM,0,PACKET)
      STATUS=RPACK(LEN,NUM,RECPKT)
      IF(.NOT.(STATUS.EQ.78))GOTO 23002
      IF(.NOT.(N.NE.(NUM-1)))GOTO 23004
      SEOF=STATE
      RETURN
23004 CONTINUE
      GOTO 23003
23002 CONTINUE
      IF(.NOT.(STATUS.EQ.89))GOTO 23006
      IF(.NOT.(N.NE.NUM))GOTO 23008
      SEOF=STATE
      RETURN
23008 CONTINUE
      NUMTRY=0
      CALL RATCLOSE(FD)
      N=MOD((N+1),64)
      TEMP=GETLIN(FILNAM,MOREFD)
      IF(.NOT.(TEMP.EQ.10003))GOTO 23010
      CALL RATCLOSE(MOREFD)
      SEOF=66
      RETURN
23010 CONTINUE
      K=1
23012 IF(.NOT.(FILNAM(K).NE.10002))GOTO 23013
      IF(.NOT.(FILNAM(K).EQ.10))GOTO 23014
      FILNAM(K)=13
23014 CONTINUE
      K=K+1
      GOTO 23012
23013 CONTINUE
      FD=RATOPEN(FILNAM,0)
      IF(.NOT.(FD.EQ.10001))GOTO 23016
      TEMP=1
23018 IF(.NOT.(TEMP.EQ.1))GOTO 23019
      XY=GETLIN(ALIN,MOREFD)
      IF(.NOT.(XY.EQ.10003))GOTO 23020
      SEOF=66
      CALL RATCLOSE(MOREFD)
      RETURN
23020 CONTINUE
      CALL SCOPY(ALIN,AONE,FILNAM,BONE)
      FD=RATOPEN(FILANM,0)
      IF(.NOT.(FD.NE.10001))GOTO 23022
      TEMP=0
23022 CONTINUE
23021 CONTINUE
      GOTO 23018
23019 CONTINUE
      SEOF=70
      RETURN
23016 CONTINUE
      SEOF=70
      RETURN
23017 CONTINUE
23011 CONTINUE
      GOTO 23007
23006 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23024
      SEOF=STATE
      RETURN
23024 CONTINUE
      SEOF=65
23025 CONTINUE
23007 CONTINUE
23003 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC   SFILE.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SFILE(X)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER NUM,LEN,COUNT,RPACK,BUFILL,X,TNUM
      INTEGER AONE,ATEN,BONE
      INTEGER ALIN(132)
      INTEGER SENDING(10)
      DATA SENDING(1),SENDING(2),SENDING(3),SENDING(4),SENDING(5),SENDIN
     *G(6),SENDING(7),SENDING(8),SENDING(9),SENDING(10)/32,83,101,110,10
     *0,105,110,103,32,10002/
      IF(.NOT.(HOST.EQ.0))GOTO 23000
      AONE=1
      BONE=1
      ATEN=10
      CALL SCOPY(SENDING,AONE,ALIN,BONE)
      CALL SCOPY(FILNAM,AONE,ALIN,ATEN)
      CALL PUTLIN(ALIN,LOCALOUTFD)
      ALIN(1)=10
      ALIN(2)=10002
      CALL PUTLIN(ALIN,LOCALOUTFD)
      CALL REMARK(" Packet #")
23000 CONTINUE
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23002
      SFILE=65
      RETURN
23002 CONTINUE
      NUMTRY=NUMTRY+1
23003 CONTINUE
      LEN=1
23004 IF(.NOT.(FILNAM(LEN).NE.10002))GOTO 23005
      LEN=LEN+1
      GOTO 23004
23005 CONTINUE
      LEN=LEN-2
      TNUM=N
      CALL SPACK(70,TNUM,LEN,FILNAM)
      STATUS=RPACK(LEN,NUM,RECPKT)
      IF(.NOT.(STATUS.EQ.78))GOTO 23006
      IF(.NOT.(N.NE.(NUM-1)))GOTO 23008
      SFILE=STATE
      RETURN
23008 CONTINUE
      GOTO 23007
23006 CONTINUE
      IF(.NOT.(STATUS.EQ.89))GOTO 23010
      IF(.NOT.(N.NE.NUM))GOTO 23012
      SFILE=STATE
      RETURN
23012 CONTINUE
      NUMTRY=0
      N=MOD((N+1),64)
      SIZE=BUFILL(PACKET)
      SFILE=68
      RETURN
23010 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23014
      SFILE=STATE
      RETURN
23014 CONTINUE
      SFILE=65
      RETURN
23015 CONTINUE
23011 CONTINUE
23007 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  SINIT.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SINIT(X)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER NUM,LEN,STATUS,RPACK,X,TNUM,TEMP
      INTEGER XY,JJ
      INTEGER ALIN(132)
      INTEGER AONE,BONE
      INTEGER MOREFILE(9)
      DATA MOREFILE(1),MOREFILE(2),MOREFILE(3),MOREFILE(4),MOREFILE(5),M
     *OREFILE(6),MOREFILE(7),MOREFILE(8),MOREFILE(9)/77,79,82,69,70,73,7
     *6,69,10002/
      INTEGER TFILE(5)
      DATA TFILE(1),TFILE(2),TFILE(3),TFILE(4),TFILE(5)/116,101,115,116,
     *10002/
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      SINIT=65
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      AONE=1
      BONE=1
      CALL SPAR(PACKET)
      TNUM=N
      CALL SPACK(83,TNUM,6,PACKET)
      STATUS=RPACK(LEN,NUM,RECPKT)
      IF(.NOT.(STATUS.EQ.78))GOTO 23002
      IF(.NOT.(N.NE.(NUM-1)))GOTO 23004
      SINIT=STATE
      RETURN
23004 CONTINUE
      GOTO 23003
23002 CONTINUE
      IF(.NOT.(STATUS.EQ.89))GOTO 23006
      IF(.NOT.(N.NE.NUM))GOTO 23008
      SINIT=STATE
      CALL REMARK("num seq don't match in sinit")
      RETURN
23008 CONTINUE
      CALL RPAR(RECPKT)
      IF(.NOT.(EOL.EQ.0))GOTO 23010
      EOL=13
23010 CONTINUE
      IF(.NOT.(QUOTE.EQ.0))GOTO 23012
      QUOTE=35
23012 CONTINUE
      NUMTRY=0
      N=MOD((N+1),64)
      MOREFD=RATOPEN(MOREFILE,0)
      TEMP=1
23014 IF(.NOT.(TEMP.EQ.1))GOTO 23015
      XY=GETLIN(ALIN,MOREFD)
      IF(.NOT.(XY.EQ.10003))GOTO 23016
      SINIT=65
      CALL RATCLOSE(MOREFD)
      RETURN
23016 CONTINUE
      CALL SCOPY(ALIN,AONE,FILNAM,BONE)
      I=1
23018 IF(.NOT.(FILNAM(I).NE.10002))GOTO 23019
      IF(.NOT.(FILNAM(I).EQ.10))GOTO 23020
      FILNAM(I)=13
23020 CONTINUE
      I=I+1
      GOTO 23018
23019 CONTINUE
      FD=RATOPEN(FILNAM,0)
      IF(.NOT.(FD.NE.10001))GOTO 23022
      TEMP=0
23022 CONTINUE
23017 CONTINUE
      GOTO 23014
23015 CONTINUE
      SINIT=70
      RETURN
23006 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23024
      SINIT=STATE
      RETURN
23024 CONTINUE
      SINIT=65
23025 CONTINUE
23007 CONTINUE
23003 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC   SPACK.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SPACK(XTYPE,NUM,LEN,XDATA)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER XTYPE,XDATA(1)
      INTEGER NUM,LEN,CH
      INTEGER I,IER,COUNT,TOCHAR
      INTEGER CHKSUM,BUFFER(100)
      CH=RMTOUTFD
      I=1
23000 IF(.NOT.(I.LE.PAD))GOTO 23001
      CALL KPUTCH(PADCHAR,CH)
      I=I+1
      GOTO 23000
23001 CONTINUE
      COUNT=1
      BUFFER(COUNT)=1
      COUNT=COUNT+1
      CHKSUM=TOCHAR(LEN+3)
      BUFFER(COUNT)=TOCHAR(LEN+3)
      COUNT=COUNT+1
      CHKSUM=CHKSUM+TOCHAR(NUM)
      BUFFER(COUNT)=TOCHAR(NUM)
      COUNT=COUNT+1
      CHKSUM=CHKSUM+XTYPE
      BUFFER(COUNT)=XTYPE
      COUNT=COUNT+1
      I=1
23002 IF(.NOT.(I.LE.LEN))GOTO 23004
      BUFFER(COUNT)=XDATA(I)
      COUNT=COUNT+1
      CHKSUM=CHKSUM+XDATA(I)
23003 I=I+1
      GOTO 23002
23004 CONTINUE
      CHKSUM=(CHKSUM+(CHKSUM.AND.192)/64).AND.63
      BUFFER(COUNT)=TOCHAR(CHKSUM)
      COUNT=COUNT+1
      BUFFER(COUNT)=EOL
      BUFFER(COUNT+1)=10002
      COUNT=1
      CH=RMTOUTFD
23005 IF(.NOT.(BUFFER(COUNT).NE.10002))GOTO 23006
      CALL KPUTCH(BUFFER(COUNT),CH)
      COUNT=COUNT+1
      GOTO 23005
23006 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  SPAR.FT          CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SPAR(XDATA)
      IMPLICIT INTEGER (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER XDATA(1)
      INTEGER CTL,TOCHAR
      XDATA(1)=TOCHAR(94 )
      XDATA(2)=TOCHAR(0)
      XDATA(3)=TOCHAR(0 )
      XDATA(4)=CTL(0 )
      XDATA(5)=TOCHAR(13 )
      XDATA(6)=35
      RETURN
      END
CCCCCCCCCCCCC  SSCOPY.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SSCOPY (FROM, TO)
      INTEGER FROM(1), TO(1)
      I = 0
23000 CONTINUE
      I=I+1
      TO(I)=FROM(I)
23001 IF(.NOT.(((TO(I).AND.177400K).EQ.0) .OR. ((TO(I).AND.377K).EQ.0)))
     *GOTO 23000
23002 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  STDIO.FT         CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE STDIO (STDIN, STDOUT, STDERR, STDCOM)                  ;00003
      INTEGER           STDIN, STDOUT, STDERR, STDCOM                   ;00004
      INCLUDE "F5ERR.FR"        ;NEEDED TO DEFINE EREOF BELOW           ;00072
      PARAMETER NULL = 0        ;ASCII NULL                             ;00074
      PARAMETER DEL  = 255      ;ASCII DEL                              ;00075
      INTEGER ARG(70), SW(2)                                            ;00077
      INTEGER INNAME(70), OUTNAME(70), ERRNAME(70)                      ;00078
      LOGICAL ISET, OSET, PIPE                                          ;00079
      LOGICAL APPOUT, DELERR                                            ;00080
      LOGICAL PSW, ISW, OSW, LSW, ESW, ASW, DSW                         ;00081
      LOGICAL NULLARG, COMEOF                                           ;00082
      COMMON /STD/ SINNAME, SOUTNAME, SERRNAME, LPTNAME                 ;00084
      INTEGER SINNAME(3), SOUTNAME(4), SERRNAME(4), LPTNAME(3)          ;00085
      DATA SINNAME  / "ST", "DI", "N<0>" /                              ;00086
      DATA SOUTNAME / "ST", "DO", "UT", 0 /                             ;00087
      DATA SERRNAME / "ST", "DE", "RR", 0 /                             ;00088
      DATA LPTNAME  / "$L", "PT", 0 /                                   ;00089
      CALL SSCOPY (SINNAME, INNAME)                                     ;00093
      CALL GCOUT (OUTNAME, IER)                                         ;00094
      CALL GCOUT (ERRNAME, IER)                                         ;00095
      ISET = .FALSE.                                                    ;00096
      OSET = .FALSE.                                                    ;00097
      PIPE = .FALSE.                                                    ;00098
      COMEOF = .FALSE.                                                  ;00099
      CALL COMINIT(STDCOM,IER)                                          ;00102
      CALL CHECK(IER)                                                   ;00103
      ASSIGN 32758 TO I32759                                            ;00106
      GO TO 32759                                                       ;00106
32758 IF(.NOT.(PSW)) GO TO 32757                                        ;00107
      ASSIGN 32755 TO I32756                                            ;00107
      GO TO 32756                                                       ;00107
32755 CONTINUE                                                          ;00107
32757 IF(.NOT.(ISW)) GO TO 32754                                        ;00108
      ASSIGN 32752 TO I32753                                            ;00108
      GO TO 32753                                                       ;00108
32752 CONTINUE                                                          ;00108
32754 IF(.NOT.(OSW)) GO TO 32751                                        ;00109
      ASSIGN 32749 TO I32750                                            ;00109
      GO TO 32750                                                       ;00109
32749 CONTINUE                                                          ;00109
32751 IF(.NOT.(LSW)) GO TO 32748                                        ;00110
      ASSIGN 32746 TO I32747                                            ;00110
      GO TO 32747                                                       ;00110
32746 CONTINUE                                                          ;00110
32748 IF(.NOT.(ESW)) GO TO 32745                                        ;00111
      ASSIGN 32743 TO I32744                                            ;00111
      GO TO 32744                                                       ;00111
32743 CONTINUE                                                          ;00111
32745 APPOUT = ASW                                                      ;00112
      DELERR = DSW                                                      ;00113
32742 CONTINUE                                                          ;00116
      ASSIGN 32740 TO I32759                                            ;00117
      GO TO 32759                                                       ;00117
32740 IF(COMEOF) GO TO 32741                                            ;00118
      IF(.NOT.(PSW)) GO TO 32739                                        ;00119
      ASSIGN 32738 TO I32756                                            ;00120
      GO TO 32756                                                       ;00120
32738 DELERR = DELERR .OR. DSW                                          ;00121
      APPOUT = APPOUT .OR. ASW                                          ;00122
32739 IF(.NOT.(ISW)) GO TO 32737                                        ;00124
      IF(.NOT.(NULLARG)) GO TO 32733                                    ;00125
      ASSIGN 32736 TO I32753                                            ;00125
      GO TO 32753                                                       ;00125
32732 CONTINUE                                                          ;00126
32736 CONTINUE                                                          ;00127
32737 IF(.NOT.(OSW)) GO TO 32731                                        ;00128
      IF(.NOT.(NULLARG)) GO TO 32729                                    ;00129
      ASSIGN 32730 TO I32750                                            ;00129
      GO TO 32750                                                       ;00129
32729 ASSIGN 32726 TO I32727                                            ;00130
      GO TO 32727                                                       ;00130
32726 CONTINUE                                                          ;00130
32730 CONTINUE                                                          ;00131
32731 IF(.NOT.(LSW)) GO TO 32725                                        ;00132
      IF(.NOT.(NULLARG)) GO TO 32723                                    ;00133
      ASSIGN 32724 TO I32747                                            ;00133
      GO TO 32747                                                       ;00133
32723 ASSIGN 32721 TO I32727                                            ;00134
      GO TO 32727                                                       ;00134
32721 CONTINUE                                                          ;00134
32724 CONTINUE                                                          ;00135
32725 IF(.NOT.(ESW)) GO TO 32742                                        ;00136
      IF(.NOT.(NULLARG)) GO TO 32716                                    ;00137
      ASSIGN 32719 TO I32744                                            ;00137
      GO TO 32744                                                       ;00137
32715 CONTINUE                                                          ;00138
32719 CONTINUE                                                          ;00139
      GO TO 32742                                                       ;00140
32741 IF(.NOT.(PIPE)) GO TO 32714                                       ;00142
      CALL DFILW (SINNAME, IER)                                         ;00143
      CALL RENAME (SOUTNAME, SINNAME, IER)                              ;00144
32714 IF(.NOT.(STDIN .GE. 0)) GO TO 32713                               ;00148
      CALL OPEN (STDIN, INNAME, 2, IER)                                 ;00149
32713 IF(.NOT.(STDOUT .GE. 0)) GO TO 32712                              ;00152
      IF(.NOT.(APPOUT)) CALL DFILW (OUTNAME, IER)                       ;00153
      CALL CFILW (OUTNAME, 2, IER)                                      ;00154
      CALL APPEND (STDOUT, OUTNAME, 0, IER)                             ;00155
      IF (IER .NE. 1) STOP "Can't open STDOUT"                          ;00156
32712 IF(.NOT.(STDERR .GE. 0)) GO TO 32711                              ;00159
      IF (DELERR) CALL DFILW (ERRNAME, IER)                             ;00160
      CALL CFILW (ERRNAME, 2, IER)                                      ;00161
      CALL APPEND (STDERR, ERRNAME, 0, IER)                             ;00162
      IF (IER .NE. 1) STOP "Can't open STDERR"                          ;00163
32711 RETURN                                                            ;00166
32759 CONTINUE                                                          ;00168
      CALL COMARG(STDCOM,ARG,SW,IER)                                    ;00169
      IF (IER .NE. 1 .AND. IER .NE. EREOF) CALL CHECK(IER)              ;00170
      COMEOF = (IER .NE. 1) .OR. BYTE(ARG,1) .EQ. DEL                   ;00172
      NULLARG = COMEOF .OR. BYTE(ARG,1) .EQ. NULL                       ;00173
      PSW = ITEST(SW(1), 0) .EQ. 1                                      ;00175
      ISW = ITEST(SW(1), 7) .EQ. 1                                      ;00176
      OSW = ITEST(SW(1), 1) .EQ. 1                                      ;00177
      LSW = ITEST(SW(1), 4) .EQ. 1                                      ;00178
      ESW = ITEST(SW(1),11) .EQ. 1                                      ;00179
      DSW = ITEST(SW(1),12) .EQ. 1                                      ;00180
      ASW = ITEST(SW(1),15) .EQ. 1                                      ;00181
      GO TO I32759                                                      ;00182
32756 CONTINUE                                                          ;00184
      IF(.NOT.(ISET)) CALL SSCOPY (SINNAME, INNAME)                     ;00185
      IF(.NOT.(OSET)) CALL SSCOPY (SOUTNAME, OUTNAME)                   ;00186
      ISET = .TRUE.                                                     ;00187
      OSET = .TRUE.                                                     ;00188
      PIPE = .TRUE.                                                     ;00189
      GO TO I32756                                                      ;00190
32753 CONTINUE                                                          ;00192
      CALL GCIN (INNAME, IER)                                           ;00193
      ISET = .TRUE.                                                     ;00194
      GO TO I32753                                                      ;00195
32750 CONTINUE                                                          ;00197
      CALL SSCOPY (SOUTNAME, OUTNAME)                                   ;00198
      OSET = .TRUE.                                                     ;00199
      GO TO I32750                                                      ;00200
32747 CONTINUE                                                          ;00202
      CALL SSCOPY (LPTNAME, OUTNAME)                                    ;00203
      OSET = .TRUE.                                                     ;00204
      GO TO I32747                                                      ;00205
32744 CONTINUE                                                          ;00207
      CALL SSCOPY (SERRNAME, ERRNAME)                                   ;00208
      GO TO I32744                                                      ;00209
32733 CONTINUE                                                          ;00211
      CALL SSCOPY (ARG, INNAME)                                         ;00212
      ISET = .TRUE.                                                     ;00213
      GO TO 32732                                                       ;00214
32727 CONTINUE                                                          ;00216
      CALL SSCOPY (ARG, OUTNAME)                                        ;00217
      OSET = .TRUE.                                                     ;00218
      GO TO I32727                                                      ;00219
32716 CONTINUE                                                          ;00221
      CALL SSCOPY (ARG, ERRNAME)                                        ;00222
      GO TO 32715                                                       ;00223
      END                                                               ;00225
CCCCCCCCCCCCC   STDOPEN.FT      CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE STDOPEN
      COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
     *:15), IC(0:15), MD(0:15)
      INTEGER CHANNEL
      INTEGER APOS
      INTEGER VPOS
      INTEGER LINEBUF
      INTEGER NC
      INTEGER IC
      INTEGER MD
      CALL STDIO (0, 1, 2, 3)
      CALL STDSETUP(0, 1, 2)
      RETURN
      END
CCCCCCCCCCCCC STDSETUP.FT       CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE STDSETUP (FDI, FDO, FDE)
      INTEGER FDI, FDO, FDE
      COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
     *:15), IC(0:15), MD(0:15)
      INTEGER CHANNEL
      INTEGER APOS
      INTEGER VPOS
      INTEGER LINEBUF
      INTEGER NC
      INTEGER IC
      INTEGER MD
      DATA CHANNEL /10001, 15*10001/
      DATA APOS / 32767 /
      DATA VPOS / 32767 /
      DATA NC / 0, 15*0 /
      DATA IC / 1, 15*1 /
      DATA MD / 2, 15*2 /
      CHANNEL(3) = 0
      CHANNEL(6) = 1
      CHANNEL(10) = 1
      CHANNEL(11) = 0
      CHANNEL(12) = 1
      IF(.NOT.(FDI.GE.0))GOTO 23000
      CHANNEL(FDI) = 0
23000 CONTINUE
      IF(.NOT.(FDO.GE.0))GOTO 23002
      CHANNEL(FDO) = 1
23002 CONTINUE
      IF(.NOT.(FDE.GE.0))GOTO 23004
      CHANNEL(FDE) = 1
23004 CONTINUE
      RETURN
      END
CCCCCCCCCCCCC  TOCHAR.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION TOCHAR(CH)
      INTEGER CH
      TOCHAR=CH+32
      RETURN
      END
CCCCCCCCCCCCC    UNCHAR.FT      CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION UNCHAR(CH)
      INTEGER CH
      UNCHAR=CH-32
      RETURN
      END
CCCCCCCCCCCCC     UPPER.FT      CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE UPPER(ALIN,BLIN)
      IMPLICIT INTEGER (A-Z)
      INTEGER ALIN(132)
      INTEGER BLIN(132)
      INTEGER UCASE(27)
      DATA UCASE(1),UCASE(2),UCASE(3),UCASE(4),UCASE(5),UCASE(6),UCASE(7
     *),UCASE(8),UCASE(9),UCASE(10),UCASE(11),UCASE(12),UCASE(13),UCASE(
     *14),UCASE(15),UCASE(16),UCASE(17),UCASE(18),UCASE(19),UCASE(20),UC
     *ASE(21),UCASE(22),UCASE(23),UCASE(24),UCASE(25),UCASE(26),UCASE(27
     *)/65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,8
     *6,87,88,89,90,10002/
      A1=1
23000 IF(.NOT.(ALIN(A1).NE.10002))GOTO 23001
      IF(.NOT.((ALIN(A1).GT.96).AND.(ALIN(A1).LT.123)))GOTO 23002
      BLIN(A1)=UCASE((ALIN(A1)-32-64))
      GOTO 23003
23002 CONTINUE
      BLIN(A1)=ALIN(A1)
23003 CONTINUE
      A1=A1+1
      GOTO 23000
23001 CONTINUE
      BLIN(A1)=10002
      RETURN
      END
CCCCCCCCCCCCC  VERIFY.FT        CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE VERIFY(INFILE)
      INTEGER INFILE(132)
      INTEGER OUTFILE(132)
      INTEGER AONE,BONE,TEMP
      AONE=1
      BONE=1
      TEMP=1
23000 IF(.NOT.((INFILE(TEMP).NE.10002).AND.(INFILE(TEMP).NE.13)))GOTO 23
     *001
      IF(.NOT.((INFILE(TEMP).GT.64).AND.(INFILE(TEMP).LT.91)))GOTO 23002
      OUTFILE(TEMP)=INFILE(TEMP)
      GOTO 23003
23002 CONTINUE
      IF(.NOT.((INFILE(TEMP).GT.47).AND.(INFILE(TEMP).LT.58)))GOTO 23004
      OUTFILE(TEMP)=INFILE(TEMP)
      GOTO 23005
23004 CONTINUE
      OUTFILE(TEMP)=46
23005 CONTINUE
23003 CONTINUE
      TEMP=TEMP+1
      GOTO 23000
23001 CONTINUE
      OUTFILE(TEMP)=10002
      CALL SCOPY(OUTFILE,AONE,INFILE,BONE)
      INFILE(11)=10002
      RETURN
      END
CCCCCCCCCCCC    THE END  CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC